Option Explicit
Sub Q_Sample045()
    ']wޥζ Windows Script Host Object Model
    Dim myWsh    As IWshRuntimeLibrary.WshShell
    Dim myShtCut As IWshRuntimeLibrary.WshShortcut
    Dim myPath   As String
    Set myWsh = CreateObject("Wscript.Shell")
    myPath = myWsh.SpecialFolders("Desktop")
    'w|W
    Set myShtCut = myWsh.CreateShortcut(myPath & "\Test.lnk")
    With myShtCut
    .TargetPath = ThisWorkbook.FullName			'wɮת|
    .Save
    End With
    Set myShtCut = Nothing					'
    Set myWsh = Nothing
End Sub
